The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/yatze.src

Text File | 1991-10-19 | 6KB | 423 lines

%%HP: T(3)A(D)F(.);
@ YATZE, a Yahtzee game, by Paul Lancaster
DIR
  YATZE
    \<<
"1S 2S 3S 4S 5S 6S"
'TS' STO
"TK FK FH SS LS YA CH"
'BS' STO { ONE TWO
TRE FOUR FIVE SIX }
DUP 'N' STO { TK FK
FH SS LS YA CH } +
'S' STO { AA BB CC
DD EE FF } 'L' STO
0 'BO' STO 20 CF Y2
    \>>
  Y2
    \<<
      IF { } S == {
BONS } S == { JOKE
} S == OR OR
      THEN CLEAR TS
BS YTOT { L BO K M
AA BB CC DD EE FF P
C S E X Y TS BS N }
PURGE 1 CF 2 CF 3
CF 4 CF 5 CF 6 CF {
YATZE } MENU
      ELSE " " 'E'
STO 1 10 0 'C' STO
        FOR F F CF
        NEXT 1 5
        START DICE
"   " + E + 'E' STO
        NEXT E 1 17
SUB 'E' STO CLEAR
TS BS E { ROLL.
HELD1 HELD2 HELD3
HELD4 HELD5 } DUP
'Y' STO MENU
      END
    \>>
  DICE
    \<< RAND 6 * CEIL
\->STR
    \>>
  ROLL.
    \<< 1 5
      FOR A
        IF A FS?
        THEN DICE E
1 A 1 - 4 * SUB
SWAP + E A 1 - 4 *
2 + 18 SUB + 'E'
STO
        END
      NEXT CLEAR TS
BS E Y MENU
      IF 6 FS?
      THEN S MENU
      ELSE 6 SF
      END
    \>>
  HELD1
    \<< 1 SF Y 1 1
SUB { TOSS1 } + Y 3
6 SUB + DUP 'Y' STO
MENU
    \>>
  HELD2
    \<< 2 SF Y 1 2
SUB { TOSS2 } + Y 4
6 SUB + DUP 'Y' STO
MENU
    \>>
  HELD3
    \<< 3 SF Y 1 3
SUB { TOSS3 } + Y 5
6 SUB + DUP 'Y' STO
MENU
    \>>
  HELD4
    \<< 4 SF Y 1 4
SUB { TOSS4 } + Y 6
6 SUB + DUP 'Y' STO
MENU
    \>>
  HELD5
    \<< 5 SF Y 1 5
SUB { TOSS5 } + DUP
'Y' STO MENU
    \>>
  TOSS1
    \<< 1 CF Y 1 1
SUB { HELD1 } + Y 3
6 SUB + DUP 'Y' STO
MENU
    \>>
  TOSS2
    \<< 2 CF Y 1 2
SUB { HELD2 } + Y 4
6 SUB + DUP 'Y' STO
MENU
    \>>
  TOSS3
    \<< 3 CF Y 1 3
SUB { HELD3 } + Y 5
6 SUB + DUP 'Y' STO
MENU
    \>>
  TOSS4
    \<< 4 CF Y 1 4
SUB { HELD4 } + Y 6
6 SUB + DUP 'Y' STO
MENU
    \>>
  TOSS5
    \<< 5 CF Y 1 5
SUB { HELD5 } + DUP
'Y' STO MENU
    \>>
  ONE
    \<< 1 'P' STO PE
    \>>
  TWO
    \<< 2 'P' STO PE
    \>>
  TRE
    \<< 3 'P' STO PE
    \>>
  FOUR
    \<< 4 'P' STO PE
    \>>
  FIVE
    \<< 5 'P' STO PE
    \>>
  SIX
    \<< 6 'P' STO PE
    \>>
  NA
    \<< 1 17
      FOR A E A A
SUB P \->STR
        IF ==
        THEN C P +
'C' STO
        END 4
      STEP
    \>>
  PE
    \<< S S N P P SUB
LIST\-> DROP POS 1 -
1 SWAP SUB S S N P
P SUB LIST\-> DROP
POS 1 + 13 SUB +
'S' STO NA C DUP 10
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END TS 1 P 1
- 3 * SUB SWAP + TS
P 3 * 20 SUB + 'TS'
STO Y2
    \>>
  TK
    \<< 2 'P' STO
'TO' 'K' STO 'TK1'
'M' STO PL
    \>>
  TK1
    \<< S S 'TK' POS
1 - 1 SWAP SUB S S
'TK' POS 1 + 14 SUB
+ 'S' STO C DUP 10
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 3 20
SUB + 'BS' STO Y2
    \>>
  FK
    \<< 3 'P' STO
'TO' 'K' STO 'FK1'
'M' STO PL
    \>>
  FK1
    \<< S S 'FK' POS
1 - 1 SWAP SUB S S
'FK' POS 1 + 14 SUB
+ 'S' STO C DUP 10
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 3
SUB SWAP + BS 6 20
SUB + 'BS' STO Y2
    \>>
  FH
    \<<
      IF 10 FS?
      THEN 25 'C'
STO FH1
      ELSE CHK 3 2
        FOR A 1 6
          FOR B L B
B SUB LIST\-> DROP
EVAL
            IF A ==
            THEN 11
A - SF
            END
          NEXT -1
        STEP
        IF 8 FS? 9
FS? AND
        THEN 25 'C'
STO FH1
        ELSE FH1
        END
      END
    \>>
  FH1
    \<< S S 'FH' POS
1 - 1 SWAP SUB S S
'FH' POS 1 + 14 SUB
+ 'S' STO C DUP 9
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 6
SUB SWAP + BS 9 22
SUB + 'BS' STO Y2
    \>>
  SS
    \<<
      IF 10 FS?
      THEN SS1
      ELSE CHK
        IF AA BB
AND CC AND DD AND
        THEN SS1
        ELSE
          IF BB CC
AND DD AND EE AND
          THEN SS1
          ELSE
            IF CC
DD AND EE AND FF
AND
            THEN
SS1
            ELSE
SS2
            END
          END
        END
      END
    \>>
  SS1
    \<< 30 'C' STO
SS2
    \>>
  SS2
    \<< S S 'SS' POS
1 - 1 SWAP SUB S S
'SS' POS 1 + 14 SUB
+ 'S' STO C DUP 9
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 9
SUB SWAP + BS 12 22
SUB + 'BS' STO Y2
    \>>
  LS
    \<<
      IF 10 FS?
      THEN LS1
      ELSE CHK
        IF AA BB
AND CC AND DD AND
EE AND
        THEN LS1
        ELSE
          IF BB CC
AND DD AND EE AND
FF AND
          THEN LS1
          ELSE LS2
          END
        END
      END
    \>>
  LS1
    \<< 40 'C' STO
LS2
    \>>
  LS2
    \<< S S 'LS' POS
1 - 1 SWAP SUB S S
'LS' POS 1 + 14 SUB
+ 'S' STO C DUP 9
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 12
SUB SWAP + BS 15 22
SUB + 'BS' STO Y2
    \>>
  YA
    \<< 4 'P' STO
'YA1' 'K' STO 'YA2'
'M' STO PL
    \>>
  YA1
    \<< S { BONS } +
'S' STO 50 'C' STO
20 SF
    \>>
  YA2
    \<<
      IF 20 FC?
      THEN S { JOKE
} + 'S' STO
      END S S 'YA'
POS 1 - 1 SWAP SUB
S S 'YA' POS 1 + 14
SUB + 'S' STO C DUP
9
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 15
SUB SWAP + BS 18 22
SUB + 'BS' STO Y2
    \>>
  PL
    \<< CHK 1 6
      FOR A L A A
SUB LIST\-> DROP EVAL
        IF P >
        THEN 7 SF
        END
      NEXT
      IF 7 FS?
      THEN K M
      ELSE M
      END
    \>>
  CH
    \<< TO S S 'CH'
POS 1 - 1 SWAP SUB
S S 'CH' POS 1 + 14
SUB + 'S' STO C DUP
10
      IF <
      THEN \->STR "0"
SWAP +
      ELSE \->STR
      END BS 1 18
SUB SWAP + 'BS' STO
Y2
    \>>
  BONS
    \<< BO 100 + 'BO'
STO JOKE
    \>>
  JOKE
    \<< CHK 1 6
      FOR A L A A
SUB LIST\-> DROP EVAL
        IF 4 >
        THEN 7 SF
        END
      NEXT
      IF 7 FS?
      THEN TS BS 10
SF "YATZE JOKER" S
MENU
      ELSE TS BS
"DO NOT CHEAT" S
MENU
      END
    \>>
  TO
    \<< E STR\-> + + +
+ 'C' STO
    \>>
  CHK
    \<< 0 'AA' STO 0
'BB' STO 0 'CC' STO
0 'DD' STO 0 'EE'
STO 0 'FF' STO 1 6
      FOR A 1 5
        FOR B E
STR\-> B PICK A
          IF ==
          THEN L
LIST\-> A 1 - - PICK
DUP EVAL 1 + SWAP
STO
          END CLEAR
        NEXT
      NEXT
    \>>
  YTOT
    \<< BO TS STR\-> +
+ + + + + DUP 62
      IF >
      THEN 35 +
      END BS STR\-> +
+ + + + + +
    \>>
  CST { YATZE }
END